Loadstar 84/084.d81/source codes/TOOLBOX SOURCE

Text File | 2022-08-26 | 13KB | 1,146 lines

.org $c000
;mem
.obj "@0:sys toolbox.o"
lda 648
cmp current'screen
beq +
jsr set'screen'table

+ jsr line'links

ldx #1
stx numbers'to'get
jsr get'number  ;get function number

lda number

cmp #11
bcc +
jmp other'table

+ cmp #0
beq help
cmp #1
beq mline
cmp #2
beq message
cmp #3
beq message'custom
cmp #4
beq screen'stash'enter
cmp #5
beq screen'restore'enter
cmp #6
beq fill'enter
cmp #7
beq box'enter
cmp #8
beq clear'line
cmp #9
beq character'swap
cmp #10
beq color'swap
rts

help jsr helpsc
rts

mline jsr move'line2
rts

message'custom ldx #6
stx numbers'to'get
jsr get'number
jsr set'message
jsr message
rts

message jsr get'string
jsr message'routine
rts

screen'stash'enter ldx #1
stx numbers'to'get
jsr get'number
jsr screen'stash
rts

screen'restore'enter ldx #1
stx numbers'to'get
jsr get'number
jsr screen'restore
rts

fill'enter ldx #5
stx numbers'to'get
jsr get'number
fill'routine jsr wait
filler jsr fill
inc number
ldx number
cpx number+1
bcc filler
rts

color'swap jsr color
rts

character'swap jsr char
rts

box'enter ldx #6
stx numbers'to'get
jsr get'number
box'routine jsr wait
boxer jsr box
inc number
ldx number
cpx number+1
bcc boxer
rts

clear'line ldx #2
stx numbers'to'get
jsr get'number
jsr wait
ldx number
- jsr 59903
inc number
ldx number
cpx number+1
bcc -
rts

other'table cmp #11
beq rvs'enter
cmp #12
beq dir'enter
cmp #13
beq file'read'enter
rts

rvs'enter ldx #5
stx numbers'to'get
jsr get'number
rvs'routine jsr wait
rvser jsr rvs
inc number
ldx number
cpx number+1
bcc rvser
rts

dir'enter ldx #1
stx numbers'to'get
jsr get'number
lda number
sta device
jsr get'string
lda #4
sta number
jsr screen'stash
lda #0
sta 212
lda #147
jsr $ffd2
jsr dir
- jsr $ffe4
beq -
lda #4
sta number
jsr screen'restore
rts

file'read'enter ldx #2
stx numbers'to'get
jsr get'number
lda number
sta device
lda number+1
sta flag
jsr get'string
lda #4
sta number
jsr screen'stash
lda #0
sta 212
lda #147
jsr $ffd2
jsr file'read
lda #4
sta number
jsr screen'restore
rts

;**** get number from BASIC ****

get'number ldx #0
stx current'number

- jsr $aefd
jsr $ad8a
jsr $b7f7
lda $14  ; got it!

ldx current'number
sta number,x
inc current'number
dec numbers'to'get
beq +
bne -
+ rts

;***** get string from BASIC ****

get'string jsr $aefd
jsr $ad9e
jsr $b6a3

ldx $22
ldy $23
stx 251
sty 252
cmp #41
bcc +
lda #40
+ sta string'length
tay

- lda (251),y
sta string3,y
dey
bpl -
rts

;**** Line Links ****

line'links ldy #24
- lda 217,y
ora #128
sta 217,y
dey
bpl -
rts

;**** wait ****
wait lda 53265
bpl wait
rts

;**** SCREEN STASH ****

screen'stash ldy number
cpy #9 ; ahem!  there are only 9 screens (0-8)
bcc +
rts

+ sei
ldx #0
lda 1
sta temp
stx 1
lda screens,y
stx 253
sta 254;  dest screen
lda 648
sta 252;  source screen
ldy #0
sty 251

;begin copying

- lda (251),y
sta (253),y
iny
bne -
inx
inc 254
inc 252

cpx #4
bne -
ldx #0

lda #>55296
sta 252

- dec 1
lda (251),y
inc 1
sta (253),y
iny
bne -
inc 252
inc 254
inx
cpx #4
bne -

lda temp
sta 1
cli
lda 53280
ldy number
sta border,y
lda 53281
sta background,y
rts

screen'restore  ldy number
cpy #9 ; ahem!  there are only 9 screens (0-8)
bcc +
rts

/ lda 53265
bpl -

sei
ldx #0
lda 1
sta temp
stx 1
lda screens,y
stx 253
sta 254;  source screen
lda 648
sta 252;  dest screen
ldy #0
sty 251

;begin copying

- lda (253),y
sta (251),y
iny
bne -
inx
inc 254
inc 252

cpx #4
bne -
ldx #0

lda #>55296
sta 252

- lda (253),y
dec 1
sta (251),y
inc 1
iny
bne -
inc 252
inc 254
inx
cpx #4
bne -

lda temp
sta 1
cli

ldy number
lda border,y
sta 53280
lda background,y
sta 53281
rts

;****** HELP ******

helpsc lda #4
sta number
jsr screen'stash

lda #0
sta 53280
sta 53281

lda #0
sta 212
lda #147
jsr $ffd2

lda #>chunk'o'text
sta 252
lda #<chunk'o'text
sta 251
ldy #0

- lda (251),y

beq finis
cmp #"\"
beq switch'to'white
cmp #"@"
beq switch'to'cyan'reverse

bump'help jsr $ffd2
cmp #13
bne +
lda 214
cmp #23
bne +
sty temp
jsr press
lda #0
sta 212
lda #147
jsr $ffd2
ldy temp

+ iny
bne -
inc 252
bne -

switch'to'white lda #1
sta 646
lda #0
sta 199
jmp bump'help

switch'to'cyan'reverse lda #3
sta 646
sta 199
jmp bump'help

finis lda #0
sta 198

jsr press

lda #4
sta number
jsr screen'restore
rts

;**** move line ****
;from line, to line

move'line2 ldx #2
stx numbers'to'get
jsr get'number
jsr wait
jsr move
rts

move lda number
bpl +
sec
sbc #128
+ cmp #25
bcc +
rts
+ asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy #39
- lda (253),y
sta string,y
lda (251),y
sta string2,y
dey
bpl -

ldx number
bmi +
jsr 59903

+ lda number+1
asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy #39
- lda string,y
sta (253),y
lda string2,y
sta (251),y
dey
bpl -

lda #19
jmp $ffd2


;**** FILL **** line,to line,col,to col,color

fill lda number
cmp #25
bcc +
rts
+ asl
tay
lda color'mem,y
sta 251
iny
lda color'mem,y
sta 252


ldy number+3
lda number+4
- sta (251),y
dey
bmi +
cpy number+2
bcs -

+ rts

;**** BOX **** lin,tlin,col,to col,s-code,color

box lda number
asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy number+3
- lda number+4
sta (253),y
lda number+5
sta (251),y
dey
bmi +
cpy number+2
bcs -
+ rts

;********** color swap ******
;color,to color

color ldx #2
stx numbers'to'get
jsr get'number

lda #>55296
sta 252
ldx #1
ldy #0
sty 251

jsr wait

- lda (251),y
and #15
cmp number
beq change'color
iny
bne -
inx
inc 252
cpx #5
bne -
rts

change'color lda number+1
sta (251),y
jmp -

;********** char swap ******
;char,to char,color

char ldx #3
stx numbers'to'get
jsr get'number

lda #>55296
sta 254
ldx #1
ldy #0
sty 251
sty 253
lda 648
sta 252

jsr wait

- lda (251),y
cmp number
beq swap
iny
bne -
inx
inc 252
inc 254
cpx #5
bne -
rts

swap lda number+1
sta (251),y
lda number+2
bmi +
sta (253),y
+ jmp -

;**** MESSAGE ****

message'routine lda #4
sta number
jsr screen'stash

lda fade'screen
beq naw
lda #0
sta number
sta number+2
lda #24
sta number+1
lda #39
sta number+3
lda fade'color
sta number+4
jsr fill'routine

naw ldy #5
- lda box'parms,y
sta number,y
dey
bpl -

jsr box'routine

lda string'length
lsr
sta string'length+1
lda #20
sec
sbc string'length+1
sta string'length+1
lda starting'line
clc
adc #1
tax
ldy string'length+1
clc

jsr plot
lda rvs'text
sta 199
lda box'color
sta 646

ldy #0

- lda string3,y
jsr $ffd2
iny
cpy string'length
bne -

- bit 197
bvs -

lda #4
sta number
jsr screen'restore
rts

;**** SET MESSAGE ****
;sys49152,2,fade?,fade color,rvs text?,box/text col,start line,char,string


set'message lda number
sta fade'screen
lda number+1
sta fade'color
lda number+2
sta rvs'text
lda number+3
sta box'color
sta box'parms+5
lda number+4
cmp #21
bcc +
lda #20
+ sta starting'line
sta box'parms
clc
adc #3
sta box'parms+1
lda number+5
sta box'parms+4
rts

plot cpx #25
bcs +
jsr $fff0
+ rts

;**** RVS **** lin,tlin,col,to col,color <128

rvs lda number
cmp #25
bcc +
rts
+ asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy number+3
- lda (253),y
eor #128
sta (253),y
lda number+4
bmi +
sta (251),y
+ dey
bmi +
cpy number+2
bcs -
+ rts

;directory

dir lda string'length
ldy #>string3
ldx #<string3
jsr $ffbd;          setnam
lda #17;            file number
ldx device
ldy #0
jsr $ffba; n        setlfs
jsr $ffc0;           open
ldx #17
jsr $ffc6;

jsr $ffcf;            get byte
jsr $ffcf;             get byte;        skip first two bytes

first jsr $ffb7;     read status
and #64
bne dir'out

jsr $ffcf;             get byte
jsr $ffcf;             get byte;         skip two bytes

second jsr $ffb7
and #64;              eof?
bne dir'out
jsr $ffcf;             get byte
tax
jsr $ffcf;             get byte
jsr $bdcd
lda " "
jsr $ffd2

jsr $ffb7
and #64;               eof?
bne dir'out

third jsr $ffcf;             get byte
bne +

lda #13
jsr $ffd2
jmp first

+ jsr $ffd2

- lda 197
cmp #64
bne -
lda 653
bne -

jsr $ffb7
and #64
bne dir'out

jmp third

dir'out lda #17
jsr $ffc3;            close17
jsr $ffcc ;clear chan

rts

file'read lda string'length
ldy #>string3
ldx #<s